home *** CD-ROM | disk | FTP | other *** search
/ Amiga Plus Special 17 / AMIGAplus Sonderheft 17 (1999)(ICP)(DE)[!].iso / Rexx / TableVérité.AmiCAD < prev    next >
Text File  |  1998-04-25  |  3KB  |  123 lines
  1. /* Création d'une table de vérité.
  2.    $VER: 1.00 (Samedi 4 Avril 1998, © R.Florac) */
  3.  
  4. options results     /* indispensable pour récupérer le résultat des macros */
  5.  
  6. signal on error     /* pour l'interception des erreurs */
  7. signal on syntax
  8.  
  9. 'ASK("Nombre d''entrées")'; nbe=result
  10. if nbe="" then exit
  11.  
  12. l=0
  13. do i=1 to nbe
  14.     'ASK("Nom de l''entrée 'i'")'; nomE.i=result
  15.     'TXWIDTH("'nomE.i'")'; lc=result
  16.     if lc>l then l=lc
  17. end
  18.  
  19. 'ASK("Nombre de sorties")'; nbs=result
  20. if nbs="" then exit
  21.  
  22. do i=1 to nbs
  23.     'ASK("Nom de la sortie 'i'")'; nomS.i=result
  24.     'TXWIDTH("'nomS.i'")'; lc=result
  25.     if lc>l then l=lc
  26. end
  27.  
  28. 'SETSCALE(0,1,1):ROTATE(0,0):SYMMETRY(0,0):DRAWMODE(1)'
  29.  
  30. nbl=2**nbe    /* nombre de lignes */
  31.  
  32. l=l+20
  33. do i=1 to nbe
  34.     cole.i=10+l*i
  35.     '(TXWIDTH("'nomE.i'")-TXWIDTH("0"))/2'
  36.     'MARK(WRITE("'nomE.i'", 'cole.i-result', 20))'
  37. end
  38.  
  39. do i=1 to nbs
  40.     cols.i=10+l*(i+nbe)
  41.     '(TXWIDTH("'nomS.i'")-TXWIDTH("0"))/2'
  42.     'MARK(WRITE("'nomS.i'", 'cols.i-result', 20))'
  43. end
  44.  
  45. do c=1 to nbe
  46.     ng=2**c
  47.     ligne=1
  48.     do i=1 to ng/2
  49.     do j=1 to nbl/ng
  50.         'MARK(WRITE("0", 'cole.c', 20+'ligne'*15))'
  51.         val.c.ligne=0
  52.         ligne=ligne+1
  53.     end
  54.     do j=j to nbl/ng*2
  55.         'MARK(WRITE("1", 'cole.c', 20+'ligne'*15))'
  56.         val.c.ligne=1
  57.         ligne=ligne+1
  58.     end
  59.     end
  60. end
  61.  
  62. /* Tracé des lignes verticales */
  63. col=cole.1-l%2+5
  64. do c=1 to nbe+nbs+1
  65.     select
  66.     when c=1 then 'DRAWMODE(2)'
  67.     when c=nbe+1 then 'DRAWMODE(2)'
  68.     when c=nbe+nbs+1 then 'DRAWMODE(2)'
  69.     otherwise 'DRAWMODE(1)'
  70.     end
  71.     'MARK(DRAW('col',8,'col',23+'nbl'*15))'
  72.     col=col+l
  73. end
  74.  
  75. /* Tracé des lignes horizontales */
  76. ligne=8
  77. do i=1 to nbl+2
  78.     select
  79.     when i=1 then 'DRAWMODE(2)'
  80.     when i=2 then 'DRAWMODE(2)'
  81.     when i=nbl+2 then 'DRAWMODE(2)'
  82.     otherwise 'DRAWMODE(1)'
  83.     end
  84.     'MARK(DRAW('cole.1-l%2+5','ligne','col-l','ligne'))'
  85.     ligne=ligne+15
  86. end
  87.  
  88. /* Remplissage éventuel de la table */
  89. 'DRAWMODE(1):REQUEST("Voulez-vous remplir la table?")'
  90. if result=1 then do
  91.     'DEF OR(A,B)=IF(A+B,1,0)'
  92.     'DEF AND(A,B)=IF(A*B,1,0)'
  93.     'DEF NOT(A)=IF(A,0,1)'
  94.     'DEF NAND(A,B)=NOT(AND(A,B))'
  95.     'DEF NOR(A,B)=NOT(OR(A,B))'
  96.     'DEF XOR(A,B)=IF(A+B==1,1,0)'
  97.     do i=1 to nbs
  98.     'ASK("Équation de 'nomS.i'?"+CHR(10)+"Vous pouvez utiliser les"+CHR(10)+"fonctions NOT(A),"+CHR(10)+"AND(A,B), OR(A,B), XOR(A,B)"+CHR(10)+"NAND(A,B) et NOR(A,B)."+CHR(10)+"Utilisez les noms des variables"+CHR(10)+"tels que vous les avez donnés.")'
  99.     eq=result
  100.     if eq~= "" then do
  101.         do ligne=1 to nbl
  102.         do j=1 to nbe
  103.             'EXEC("'nomE.j'='val.j.ligne'")'
  104.         end
  105.         'EXEC("'eq'")'; r=result
  106.         'MARK(WRITE("'r'",'cols.i','20+ligne*15'))'
  107.         end
  108.     end
  109.     end
  110. end
  111.  
  112. exit
  113.  
  114. /* Traitement des erreurs, interruption du programme */
  115. syntax:
  116. erreur=RC
  117. 'MESSAGE("Script TableVérité"+CHR(10)+"Erreur de syntaxe"+CHR(10)+"en ligne 'SIGL'"+CHR(10)+"'errortext(erreur)'")'
  118. exit
  119.  
  120. error:
  121. 'MESSAGE("Script TableVérité"+CHR(10)+"Erreur en ligne 'SIGL'")'
  122. exit
  123.